#lang scheme
;; Make sure you have Internet connection when run this program first time. ("require" will download files from PLT server)
(require test-engine/scheme-tests)
(require (planet soegaard/sicp:2:1/sicp))
(require works/sicp-chap-1)
(require works/sicp-chap-2)

;;document copy from http://planet.plt-scheme.org/package-source/soegaard/sicp.plt/1/1/doc.txt
;;----------------------------------------------------------------------
;;  _The SICP Picture Language_    
;;----------------------------------------------------------------------
;; 
;;----------------------------------------------------------------------
;;INTRODUCTION
;;----------------------------------------------------------------------
;;
;;The SICP Picture Language is a small language for drawing pictures.
;;It shows the power of data abstraction and closure. The picture language
;;stems from Peter Henderson's 1982 paper "Functional Geometry" and was
;;included by Hal Abelson in "Structure and Interpretation of Computer 
;;Programs".  
;;
;;Before using this package, read section 2.2.4 of SICP, which is
;;an excellent introduction to the ideas of the picture language.
;;The documentation below is only meant as a quick reference guide.
;;
;;<http://mitpress.mit.edu/sicp/full-text/book/book-Z-H-15.html#%_sec_2.2.4>
;;
;;Peter Henderson has written an updated version of "Functional Geometry",
;;which explains how to construct the Escher fish image.
;;
;;<http://eprints.ecs.soton.ac.uk/7577/01/funcgeo2.pdf>
;;
;;
;;Note: The primitives cons-stream and amb needed in other chapters
;;      of SICP is also provided.
;;
;;----------------------------------------------------------------------
;;REFERENCE
;;----------------------------------------------------------------------
;;
;;The basic concept of the picture language is a _painter_. A painter draws 
;;it's image (shifted and scaled) within a frame given by a parallelogram.
;;Painters can be combined to construct new painters.
;;
;;EXAMPLE
;;-------
;;
;;> (require (planet "sicp.ss" ("soegaard" "sicp.plt" 1 1)))
;;> (paint (number->painter 0))
;;> (paint diagonal-shading)
;;> (paint-hires  (below (beside diagonal-shading 
;;                        (rotate90 diagonal-shading))
;;                (beside (rotate270 diagonal-shading)
;;                        (rotate180 diagonal-shading))))
;;> (paint einstein)
;;
;;TEST CASES
;;--------
;; TEST BITMAP PAINTERS
;;(paint einstein)
;;(display "should be: image of einstein\n")
;;
;;(paint (rotate90 einstein))
;;(display "should be: image of einstein rotate 90 degrees counter clockwise\n")
;;
;;
;;; TEST SEGMENTS PAINTERS
;;(paint (segments->painter 
;;        (list (make-segment (make-vect 0.0 0.0) 
;;                            (make-vect 0.5 0.5))))) 
;;(display "should be: image with segment from lower left to the center\n")
;;
;;(paint (rotate90 
;;        (segments->painter 
;;         (list (make-segment (make-vect 0.0 0.0) 
;;                             (make-vect 0.5 0.5))))))
;;(display "should be: image with segment from lower right to the center\n")
;; 
;;; TEST NUMBER PAINTERS
;;(paint (number->painter 0))
;;(display "should be: black square\n")
;;(paint (number->painter 128))
;;(display "should be: grey square\n")
;;(paint (number->painter 255))
;;(display "should be: white square\n")
;;
;;; TEST PROCEDURE PAINTERS
;;(paint (procedure->painter (lambda (x y) (* 255 x y))))
;;(display "should be: shaded image, where the lower left is black and the upper right white\n")
;;
;;VECTORS
;;-------
;;
;;An mathematical vector is called a vect here, in order
;;to avoid confusion with the builtin vectors of Scheme.
;;
;;> make-vect : number number -> vect
;;Construct a vect with the given coordinates.
;;
;;> vector-xcor : vect -> number
;;Return the x-coordinate of the vect.
;;
;;> vector-ycor : vect -> number
;;Return the y-coordinate of the vect.
;;
;;> vector-add : vect vect -> vect
;;Add two vect by adding their coordinated pairwise.
;;
;;> vector-sub : vect vect -> vect
;;Subtract two vects by subtracting their coordinated pairwise.
;;
;;> vector-scale : number vect -> vect
;;Scale the vect by multiplying each coordinate with the number.
;;
;;
;;FRAMES
;;------
;;
;;A frame is descibed by three vectors.
;;
;;      ^
;;      | frame edge2 vector
;;      |
;;     _|__________>
;;     /|         frame edge1 vector
;;    /
;;   /
;;  / frame origin pointer
;;
;;
;;> make-frame : origin edge1 edge2 -> frame
;;Construct a frame from a frame origin vector and two frame edge vectors.
;;
;;> frame-origin : frame -> vect
;;> frame-edge1 : frame -> vect 
;;> frame-edge2 : frame -> vect 
;;Extracts the origin, first edge or second edge from a frame.
;;
;;> make-relative-frame : origin corner1 corner2 -> (frame -> frame)
;;
;;The procedure make-relative-frame provides a convenient way to
;;transform frames.  Given a frame and three points : origin, corner1, 
;;and corner2 (expressed in frame coordinates), it returns a new frame 
;;with those corners.
;;
;;
;;> frame-coord-map : frame -> (vect -> vect)
;;
;;Each frame determines a system of "frame coordinates" (x,y) where
;;(0,0) is the origin of the frame, x represents the displacement 
;;along the first edge (as a fraction of the length of the edge) and 
;;y is the displacement along the second edge.
;;
;;The frame coordinate map is returned by frame-coord-map. E.g
;;these expression return the same value:
;;   ((frame-coord-map a-frame) (make-vect 0 0)) 
;;   (frame-origin a-frame)
;;
;;
;;SEGMENTS
;;--------
;;
;;A pair of vectors determines a directed line segment - the segment
;;running from the endpoint of the first vector to the endpoint of the
;;second vector.
;;
;;> make-segment : vect vect -> segment
;;> segment-start : segment -> vect
;;> segment-end : segment -> vect 
;;
;;
;;
;;PRIMITIVE PAINTERS
;;------------------
;;
;;Painters take a frame and draw an image, transformed to fit inside the frame.
;;
;;There are four ways to create painters:
;;
;;  1) from a constant:               number->painter
;;  2) from a list of line segments:  segment->painter
;;  3) form a procedure:              procedure->painter
;;  4) from a picture:                picture->painter
;;
;;
;;> number->painter : 0..255 -> painter
;;Construct a painter that fills the frame with a gray color indicated
;;by the number. 0 is black and 255 is white.
;;
;;
;;> segments->painter : list-of-segment -> painter
;;Construct a painter that draws a stick figure given by the 
;;segments (wrt the unit square).
;;
;;
;;> procedure->painter : procedure -> painter
;;
;;Creating painters from procedures.  We assume that the procedure
;;f is defined on the unit square.
;;
;;Then to plot a point p in the target frame, we find the inverse image 
;;T^-1(p) of p under the transformation that maps the unit square to the 
;;target, and find the value of f at T-1(p).
;;
;;
;;> picture->painter : picture -> painter
;;
;;The picture p is defined on some frame. 
;;
;;Given a point p in the target frame, we compute T^-1(p) where T
;;is the transformation that takes the picture frame to the 
;;target frame, and find the picture value at the closest
;;integer point.
;;
;;
;;> load-painter : file-name -> painter
;;Uses the picture in file-name to create a painter.
;;
;;
;;
;;HIGHER ORDER PAINTERS
;;---------------------
;;
;;>  transform-painter : origin corner1 corner2 -> (painter -> painter)
;;
;;A painter can be transformed to produce a new painter which, when
;;given a frame, calls the original painter on the transformed frame.
;;
;;Transform-painter will given an origin and two corners, return
;;a function that takes a painter as argument and returns
;;a transformed painter.
;;
;;> flip-horiz : painter -> painter
;;Returns a painter that flips the image horizontally.
;;
;;> flip-vert : painter -> painter
;;Returns a painter that flips the image vertically.
;;
;;> rotate90 : painter -> painter
;;> rotate180 : painter -> painter
;;> rotate270 : painter -> painter
;;Returns a painter that totates the image.
;;
;;
;;> beside : painter painter -> painter
;;Constructs a painter that paints the images side-by-side.
;;
;;> below : painter painter -> painter
;;Constructs a painter that paints the second image
;;below the first.
;;
;;> superpose : painter painter -> painter
;;Constructs a painter that paints the two images
;;on top of each other.
;;
;;
;;
;;SIMPLE BUILTIN PAINTERS
;;-----------------------
;;
;;The following painter values are buitin:
;;
;;  black, white and gray 
;;     Fills the frame with black (0), white (255) or gray (150).
;;
;;  diagonal-shading  
;;    Fills the frame with a shades of gray. The color transition
;;    goes from black in the upper left corner is black, to gray
;;    in the bottom right corner.
;;
;;  einstein 
;;    Draws an image of Einstein.
;;
;;
;;PAINTING
;;--------
;;
;;The procedures paint and paint-hi-res takes a painter as input
;;and return a snip containing the painter's image. A snip is
;;an image that DrScheme can display automatically.
;;
;;> paint : painter -> snip
;;> paint-hi-res : painter -> snip
;;
;;
;;----------------------------------------------------------------------
;;AUTHORS
;;----------------------------------------------------------------------
;;
;;Abelson & Sussman: 
;;  <http://mitpress.mit.edu/sicp/full-text/book/book-Z-H-15.html#%_sec_2.2.4>
;;
;;Daniel Coore: Original MIT Scheme code
;;
;;Mike Sperber: PLT port
;;
;;Jens Axel Søgaard: Documentation 
;;
;;----------------------------------------------------------------------
;;OTHER
;;----------------------------------------------------------------------
;;
;;See also
;;
;;    <http://mitpress.mit.edu/sicp/psets/ps4hnd/readme.html>
;;
;;for more documentation and exercises.
;;
;;Peter Henderson's "Functional Geometry":
;;
;;    <http://eprints.ecs.soton.ac.uk/7577/01/funcgeo2.pdf>


;(paint (number->painter 0))
;(paint (number->painter 100))
;(paint diagonal-shading)
;(paint-hires  (below (beside diagonal-shading 
;                        (rotate90 diagonal-shading))
;                (beside (rotate270 diagonal-shading)
;                        (rotate180 diagonal-shading))))
(display "\ntest (paint einstein)\n")
(paint einstein)

(define einstein2 (beside einstein (flip-vert einstein)))
(display "\ntest (paint einstein2)\n")
(paint einstein2)


(define einstein4 (below einstein2 einstein2))
(display "\ntest (paint einstein4)\n")
(paint einstein4)

(define (right-split painter n)
  (if (= n 0)
      painter
      (let ((smaller (right-split painter (- n 1))))
        (beside painter (below smaller smaller)))))

(display "\ntest (right-split einstein 4)\n")
(paint (right-split einstein 4))

;; Ex.2.44
(define (up-split painter n)
  (if (= n 0)
      painter
      (let ((smaller (up-split painter (- n 1))))
        (below painter (beside smaller smaller)))))

(display "\nEx.2.44 test (up-split einstein 4)\n")
(paint (up-split einstein 4))

(define (corner-split painter n)
  (if (= n 0)
      painter
      (let ((up (up-split painter (- n 1)))
            (right (right-split painter (- n 1))))
        (let ((top-left (beside up up))
              (bottom-right (below right right))
              (corner (corner-split painter (- n 1))))
          (beside (below painter top-left)
                  (below bottom-right corner))))))

(display "\ntest (corner-split einstein 4)\n")
(paint (corner-split einstein 4))

(define (flipped-pairs painter)
  (let ((painter2 (beside painter (flip-vert painter))))
    (below painter2 painter2)))

(define (square-limit painter n)
  (let ((quarter (corner-split painter n)))
    (let ((half (beside (flip-horiz quarter) quarter)))
      (below (flip-vert half) half))))

(display "\ntest (square-limit einstein 4)\n")
(paint (square-limit einstein 4))

(define (square-of-four tl tr bl br)
  (lambda (painter)
    (let ((top (beside (tl painter) (tr painter)))
          (bottom (beside (bl painter) (br painter))))
      (below bottom top))))

(define (flipped-pairs-2 painter)
  (let ((combine4 (square-of-four identity flip-vert
                                  identity flip-vert)))
    (combine4 painter)))

(display "\ntest (flipped-pairs-2 einstein)\n")
(paint (flipped-pairs-2 einstein))

(define (square-limit-2 painter n)
  (let ((combine4 (square-of-four flip-horiz identity
                                  rotate180 flip-vert)))
    (combine4 (corner-split painter n))))

(display "\ntest (square-limit-2 einstein 4)\n")
(paint (square-limit-2 einstein 4))

;; Ex.2.45
(define (split op1 op2)
  (lambda (painter n)
    (if (= n 0)
      painter
      (let ((smaller ((split op1 op2) painter (- n 1))))
        (op1 painter (op2 smaller smaller))))))

(define right-split-2 (split beside below))
(display "\nEx.2.45 test (right-split-2 einstein 4)\n")
(paint (right-split-2 einstein 4))

(define up-split-2 (split below beside))
(display "\nEx.2.45 test (up-split-2 einstein 4)\n")
(paint (up-split-2 einstein 4))

;; Ex.2.46 
(define (frame-coord-map* frame)
  (lambda (v)
    (add-vect
     (origin-frame frame)
     (add-vect (scale-vect (xcor-vect v)
                           (edge1-frame frame))
               (scale-vect (ycor-vect v)
                           (edge2-frame frame))))))

(define (make-vect* x y)
  (cons x y))
(define (xcor-vect v)
  (car v))
(define (ycor-vect v)
  (cdr v))
(define (add-vect v1 v2)
  (cons 
   (+ (xcor-vect v1) (xcor-vect v2))
   (+ (ycor-vect v1) (ycor-vect v2))))
(define (sub-vect v1 v2)
  (cons 
   (- (xcor-vect v1) (xcor-vect v2))
   (- (ycor-vect v1) (ycor-vect v2))))  
(define (scale-vect s v)
  (cons 
   (* s (xcor-vect v))
   (* s (ycor-vect v))))

(define v1 (make-vect* 1 2))
(define v2 (make-vect* 4 8))
(check-expect (add-vect v1 v2) (make-vect* 5 10))
(check-expect (sub-vect v1 v2) (make-vect* -3 -6))
(check-expect (scale-vect 2 v1) (make-vect* 2 4))

;; Ex.2.47
(define (make-frame* origin edge1 edge2)
  (list origin edge1 edge2))
(define (origin-frame f)
  (car f))
(define (edge1-frame f)
  (cadr f))
(define (edge2-frame f)
  (caddr f))
(define f1 (make-frame* '(0 0) '(1 0) '(0 1)))
(check-expect f1 '((0 0) (1 0) (0 1)))
(check-expect (origin-frame f1) '(0 0))
(check-expect (edge1-frame f1) '(1 0))
(check-expect (edge2-frame f1) '(0 1))

;; Ex.2.48
;(define (segments->painter* segment-list)
;  (lambda (frame)
;    (for-each
;     (lambda (segment)
;       (draw-line ;; how to define it
;        ((frame-coord-map frame) (start-segment segment))
;        ((frame-coord-map frame) (end-segment segment))))
;     segment-list)))
(define (make-segment* start end)
  (cons start end))
(define (start-segment segment)
  (car segment))
(define (end-segment segment)
  (cadr segment))

;; Ex.2.49.a
(define v11 (make-vect 0 0))
(define v12 (make-vect 1 0))
(define v13 (make-vect 0 1))
(define v14 (make-vect 1 1))

(define s1 (make-segment v11 v12 ))
(define s2 (make-segment v12 v14 ))
(define s3 (make-segment v14 v13 ))
(define s4 (make-segment v11 v13 ))
(paint (segments->painter 
        (list s1 s2 s3 s4)))
;; Ex.2.49.b
(define s5 (make-segment v11 v14 ))
(define s6 (make-segment v12 v13 ))
 (paint (segments->painter 
        (list s5 s6)))
 
((transform-painter v11 (make-vect 0.7 0.1) (make-vect 0.3 0.9)) einstein)
;; Ex.2.49.c use vector-add and vector-scale, skip
 
;; below two exercises are key in 2.2.4, but it is hard for me to debug multi-files in DrScheme, 
;; and I don't want to entangled in low level details, so delay this.
;; Ex.2.50
;; Ex.2.51
;; Ex.2.52

;; run all test
;(test)